home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / dev / amos / AMCAFExa.lha / AMCAF_Examples / SetRainColour3.AMOS / SetRainColour3.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1996-01-17  |  4.3 KB  |  123 lines
  1. ' ************************************* Commands used: 
  2. ' *                                   * Set Rain Colour  
  3. ' *           Amcaf Examples          *  
  4. ' *       Set Rain Colour 3 V1.0      *    
  5. ' *      Written by Chris Hodges      *  
  6. ' *                                   *  
  7. ' *************************************  
  8. '
  9. ' *** WARNING!!! *** 
  10. ' This program will only work, if the AMOSPro.Lib Patch has been installed.
  11. ' Otherwise you'll get a very nice black screen. 
  12. '
  13. ' First, hide the mouse cursor for niceness. 
  14. Hide 
  15. ' Unpack a neat little 4 coloured antialiased font onto a screen.    
  16. Unpack 16 To 0 : Screen Hide 
  17. ' Pack the letters into blocks, as they are more handy and faster for this 
  18. ' special usage. 
  19. For A=0 To 58
  20.   Get Block A+1,(A mod 20)*16,(A/20)*16,16,16
  21. Next 
  22. ' Open a overscanned, oversized screen. This screen is 64 pixels taller than 
  23. ' the double of the viewable display height. 
  24. Screen Open 0,352,576,4,0
  25. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  26. ' Set the right palette for the font.
  27. Palette 0,$FFF,$999,$555
  28. ' Bring the screen into the right place. 
  29. Screen Display 0,104,40,352,256
  30. ' Reset the y scroll position. 
  31. YPOS=0
  32. ' And set the offset to the right value. 
  33. Screen Offset 0,0,YPOS+24
  34. ' Define some scrolltext. Note the use of the dollar symbol as line-seperator. 
  35. T$="THIS IS$$A$$SUPER$SOFT$SCROLLER$$$IT WAS ARCHIEVED$USING AN$$"
  36. T$=T$+"INTERLACE TRICK!$$$$$$SOMEWHAT SMOOTH, EH?$$$$$$$$"
  37. ' Now here comes the tricky part.
  38. ' We reserve a little rainbow, whichs sets the BPLCON0 register. 
  39. ' This register contains the display mode an colours.
  40. ' A normal 4-coloured lowres screen has following value: 
  41. ' BPLCON0=$2200. $4 turns the interlace mode on. If we set on interlace
  42. ' we can double the lines. 
  43. ' A interlace screen consists of a long frame (which has 313 raster lines) and 
  44. ' a short frame (whichs contains 312 raster lines).
  45. ' The short frame is a bit lower than a long frame. If we scroll in the right
  46. ' moment, the scroller seems to be pushed up one by half a line. 
  47. ' This results in a super smooth scroller. 
  48. Set Rainbow 0,0,16,"","",""
  49. For A=0 To 15
  50.   Rain(0,A)=$2204
  51. Next 
  52. ' Now redirect the colour to the BPLCON0 register. 
  53. ' (BPLCON0=$100 -> ($100-$180)/2=-64 
  54.  Extension_8_1330 0,-64
  55. ' Bring the interlace-rainbow to the screen. 
  56. Rainbow 0,0,Y Hard(-1),260
  57. ' BP is the counter for the current letter in the scrolltext.
  58. BP=1
  59. Repeat 
  60.   ' We draw one letter.
  61.   Gosub PULET
  62.   ' And then we look for the right interlace frame. If did not check for the 
  63.   ' long frame, we would end up in some rather flickery mess.  
  64.   If Deek($DFF004) and $8000 Then Wait Vbl 
  65.   ' Draw a second one. We must do that, because a line can hold up to
  66.   ' 22 letters, but there are only 16 steps between each line. 
  67.   Gosub PULET
  68.   ' Scroll up a line and wait for the long frame.  
  69.   Add YPOS,1,0 To 287
  70.   Screen Offset 0,0,YPOS+24
  71.   Wait Vbl 
  72. Until Inkey$=Chr$(27) or Mouse Key<>0
  73. ' The quitting check has been inserted for TV-Users. On TVs, when exiting
  74. ' from a interlace screen mode, the last frame must be a long frame. 
  75. ' Or the normal non-interlaced screen will be a little bit corrupted.
  76. ' I know that, because I currently use a TV instead of a monitor.
  77. If Deek($DFF004) and $8000 Then Wait Vbl 
  78. ' Turn interlace off and close the screen. 
  79. Rainbow Del : View 
  80. Screen Close 0
  81. End 
  82. ' The following subroutine pastes a letter onto the screen.
  83. ' It has been very split up into various pieces to spread the processor
  84. ' power onto serveral stages.
  85. PULET:
  86.   ' Get the Text-Line for the current position.
  87.   YP=YPOS and $FFF0
  88.   ' Check if we have scrolled into the next line. Yes? Then reset the
  89.   ' counter LP.
  90.   If(YPOS and 15)=0 Then LP=0
  91.   ' The first line will be used to calculate the new x position of the 
  92.   ' text line. 
  93.   If LP=0
  94.     XP=184
  95.     For A=BP To Len(T$)
  96.       Exit If Mid$(T$,A,1)="$"
  97.       Add XP,-8
  98.     Next 
  99.     Inc LP : Return 
  100.   End If 
  101.   ' Clear the old upper text line. 
  102.   If LP=1
  103.     Ink 0 : Bar 0,YP To 351,YP+15
  104.     Inc LP : Return 
  105.   End If 
  106.   ' Clear the old lower text line. 
  107.   If LP=2
  108.     Ink 0 : Bar 0,YP+288 To 351,YP+303
  109.     Inc LP : Return 
  110.   End If 
  111.   ' Draw a letter both in upper and lower text line. 
  112.   If LP=3
  113.     P=Asc(Mid$(T$,BP,1))
  114.     Add BP,1,1 To Len(T$)
  115.     If P=36
  116.       LP=-1
  117.     Else 
  118.       Put Block P-31,XP,YP
  119.       Put Block P-31,XP,YP+288
  120.       Add XP,16
  121.     End If 
  122.   End If 
  123. Return